C       PROGRAM EXA11 for FORTRAN-86
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id.     Example_11x,cInformation System         /
C/      Date-written.   11th,Feb,1984                           /
C/      Date-updadted.  17th,Feb,1984 for FORTRAN-86            /
C/      Remarks.        A main program of Information service   /
C/                      system, from page 269.                  /
C/                      This program uses GASP IIex version.    /
C/                                                              /
C////////////////////////////////////////////////////////////////
C
        CHARACTER*12    FILE
        DIMENSION       NSET( 120 ), QSET( 30 )
        COMMON/C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
     $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
        COMMON/C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
     $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
     $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
     $  JCLR,JTRIB(12)
        COMMON /U1/ NARC,NSCAN,JBUFF,NSTA(10),JRPLY(10)
        COMMON /U2/ XL,NTER,IBUFF,CDIAL(2),CREAD(2),SRTIM,SCTIM,
     $  TRTIM,DLTIM,COMTIM(2)
C
C       --- Start of Main program of Information System.
C
        NCRDR = 6
C
        MODE = 2
        IDRIVE = 0
        WRITE( 1,90 )
90      FORMAT(1H0,'Output GASP data file to Display(1) or Printer(4)'
     $  ,/1H ,'Enter Output Device number 1 or 4 : '$ 
        READ( 1,95 ) NPRNT
95      FORMAT( I1 )
        WRITE( 1,100 )
100     FORMAT(1H ,'Input GASPex data file name ( max 12 characters ):'$
        READ( 1,200 ) FILE
        WRITE( 1,210 ) FILE
200     FORMAT( A0 )
210     FORMAT( 1H ,'Input GASPex Data file name : ',A0 )
C
        IF ( IOREAD( NCRDR,MODE,IDRIVE,FILE ) ) GO TO 300
C
C
C       --- Initial conditions for he simulation are no customers in
C           the system. the scanner is at position (1), the buffer sto-
C           rage is not blocked, all stations have no customers in them
C           and all lines are free.
C
        NARC = 0
        NSCAN = 1
        JBUFF = 0
        DO 10 I=1,10
        NSTA( I ) = 0
10      JRPLY( I ) = 1
C
        CALL    GASP( NSET,QSET )
        GO TO 500
300     WRITE( 1,400 ) 'Open or Read error on file at main_pgm'
400     FORMAT( ' ',A0 )
500     CALL    EXIT
        END
        SUBROUTINE      EVNTS( I,NSET,QSET )
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id.     EVNTS.FOR                               /
C/      Date-written.   11th,Feb,1984                           /
C/      Remarks.        The user defined events routine for     /
C/                      Information system, from page 270       /
C/                                                              /
C////////////////////////////////////////////////////////////////
        DIMENSION       NSET(1),QSET(1)
        COMMON/C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
     $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
        COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
     $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
     $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
     $  JCLR,JTRIB(12)
        COMMON /U1/ NARC,NSCAN,JBUFF,NSTA(10),JRPLY(10)
        COMMON /U2/ XL,NTER,IBUFF,CDIAL(2),CREAD(2),SRTIM,SCTIM,
     $  TRTIM,DLTIM,COMTIM(2)
C
C
C       --- SET INITIAL USER VARIABLES.
C
        NTER = PARAM( 1,1 )
        IBUFF = PARAM( 1,2 )
        XL = PARAM( 1,3 )
        CDIAL(1) = PARAM( 2,1 )
        CDIAL(2) = PARAM( 2,2 )
        CREAD(1) = PARAM( 3,1 )
        CREAD(2) = PARAM( 3,2 )
        SRTIM = PARAM( 4,1 )
        SCTIM = PARAM( 4,2 )
        TRTIM = PARAM( 5,1 )
        DLTIM = PARAM( 5,2 )
        COMTIM(1) = PARAM( 6,1 )
        COMTIM(2) = PARAM( 6,2 )
C
        GO TO (1,2,3,4,5),I
1       CALL    ARRVL( NSET,QSET )
        RETURN
2       CALL    RQEST( NSET,QSET )
        RETURN
3       CALL    SCAN( NSET,QSET )
        RETURN
4       CALL    ANSER( NSET,QSET )
        RETURN
5       CALL    ENDSV( NSET,QSET )
        RETURN
        END
        SUBROUTINE      OTPUT( NSET,QSET )
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id.     OTPUT.FOR                               /
C/      Date-written.   11th,Feb,1984                           /
C/      Remarks.        User optinal output routine for         /
C/                      Information system from page 270        /
C/                                                              /
C////////////////////////////////////////////////////////////////
C
        INTEGER*1       DOT( 90 )
        DIMENSION       NSET(1),QSET(1),DIST(22)
        COMMON/C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
     $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
        COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
     $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
     $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
     $  JCLR,JTRIB(12)
        COMMON /U1/ NARC,NSCAN,JBUFF,NSTA(10),JRPLY(10)
        COMMON /U2/ XL,NTER,IBUFF,CDIAL(2),CREAD(2),SRTIM,SCTIM,
     $  TRTIM,DLTIM,COMTIM(2)
C
C
        SIMTIM = TFIN - TBEG
        EFECT  = FLOAT( NARC ) / SIMTIM
        WRITE( NPRNT,290 ) NPROJ,NAME,MON,NDAY,NYR,SIMTIM
290     FORMAT( 1H1,'Simulation Project no.',I4,2X,'on',2X,6A2,
     $  //,' Date',I3,'/',I3,'/',I5,5X,'Simulation time : ',F5.0,
     $  ' min ' )
        WRITE(NPRNT,380 ) NTER,IBUFF,XL,CDIAL(1),CDIAL(2),CREAD(1),
     $  CREAD(2),SRTIM,SCTIM,TRTIM,DLTIM,COMTIM(1),COMTIM(2)
380     FORMAT(1H ,'Numbers of stations : ',I2/
     $  1H ,'Max size of buffer         : ',I2/
     $  1H ,'Mean time between arrivals of customers : ',F4.1,
     $  /1H ,'Customers dialing time range : ',F4.1,2X,F4.1,
     $  /1H ,'Customers reading time range : ',F4.1,2X,F4.1,
     $  /1H ,'Scanner rotation time and scanning time : ',F7.4,2X,F7.4,
     $  /1H ,'Scanner transfer time and delay time    : ',F7.4,2X,F7.4,
     $  /1H ,'Computing time range : ',F6.3,2X,F6.3 )
        WRITE( NPRNT,385 )
385     FORMAT(1H ,'------------------------------------------------',
     $  '---------------------------' )
        WRITE( NPRNT,901 ) NARC
901     FORMAT( 1H ,'Total customers served is : ',I6,' persons ' )
        WRITE( NPRNT,902 ) EFECT
902     FORMAT( 1H ,'Customers served / Simulation time : ',F7.4,
     $  ' persons/min ' )
        WRITE( NPRNT,905 ) ( NSTA(I),I=1,NTER )
905     FORMAT(1H ,'Number of customers waiting at station at end : ',/
     $  1H ,10(I5,2X) )
C
C       --- Define user output
C
        SUMT = SRTIM + SCTIM + TRTIM + DLTIM
        DELT = ( COMTIM(2) - COMTIM(1) + SUMT ) / 20.0
        SUMH = 0
        NCL = NCELS( 1 ) + 2
        DO 910 I=1,NCL
910     SUMH = SUMH + JCELS( 1,I )
        DO 920 I=1,NCL
920     DIST( I ) = FLOAT( JCELS( 1,I ) ) / SUMH * 100.0
        WRITE( NPRNT,925 )
925     FORMAT(1H ,'Average time to obtain a display Distribution : ' )
        WRITE( NPRNT,930 )
930     FORMAT(1H ,'Upper Limit  Observations  Percentage ' )
        DO 940 I=1,NCL
        DO 950 J=1,90
        DOT( J ) = ' '
950     CONTINUE
        DOT( 1 ) = '|'
        K = IFIX( ( DIST( I ) + 0.5 ) * 0.9 )
        IF ( K.LE.0 ) GO TO 960
        DO  980  M=1,K
980     DOT( M ) = '@'
960     IF ( NPRNT.NE.4 ) GO TO 975
        WRITE( NPRNT,970 ) SUMT,JCELS(1,I),DIST(I),( DOT(L),L=1,90 )
        GO TO 976
975     WRITE( NPRNT,977 ) SUMT,JCELS(1,I),DIST(I)
977     FORMAT(3X,F6.3,8X,I3,9X,F6.2 )
976     CONTINUE
970     FORMAT(3X,F6.3,8X,I3,9X,F6.2,3X,90A1 )
        SUMT = SUMT + DELT
940     CONTINUE
        WRITE( NPRNT,1000 )
1000    FORMAT( 1H1 )
        RETURN
        END
        SUBROUTINE      ARRVL( NSET,QSET )
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id.     ARRVL.FOR                               /
C/      Date-written.   11th,Feb,1984                           /
C/      Remarks.        Subroutine ARRVL is called each time    /
C/                      a new customer arrives to the system    /
C/                      from page 272                           /
C/                                                              /
C////////////////////////////////////////////////////////////////
C
        DIMENSION       NSET(1),QSET(1)
        COMMON/C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
     $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
        COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
     $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
     $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
     $  JCLR,JTRIB(12)
        COMMON /U1/ NARC,NSCAN,JBUFF,NSTA(10),JRPLY(10)
        COMMON /U2/ XL,NTER,IBUFF,CDIAL(2),CREAD(2),SRTIM,SCTIM,
     $  TRTIM,DLTIM,COMTIM(2)
C
C       --- Determine the station number that the arriving customer
C           will go to by sampling from a uniform distribution.
C           Collect statistics on number of customers at the station
C           to which the new arrival is going.
C
        NARC = NARC + 1
        J = 1
        ICHEK = NSTA( 1 )
        DO 10 I=2,NTER
        IF( ICHEK.LE.NSTA( I ) ) GO TO 10
        ICHEK = NSTA( I )
        J = I
10      CONTINUE
        X = NSTA( J )
        CALL    TMST( X,TNOW,J,NSET,QSET )
C
C       --- Allow customer to make his request immediately since 
C           station was idle.
C
        IF ( NSTA(J) ) 2,2,3
2       ATRIB(1) = TNOW + UNFRM( CDIAL(1),CDIAL(2) )
        JTRIB(1) = 2
        JTRIB(2) = J
        CALL    FILEM( 1,NSET,QSET )
C
C       --- Increment number of customer at station J by one
C
3       NSTA( J ) = NSTA( J ) + 1
C
C       --- Schedule next customer arrival at current time olus a
C           sample from an exponential distribution.
C           Customers request is completed. Store request in file 
C           of calls requested but not in buffer. 
C
        CALL    DRAND( ISEED,RNUM )
        ATRIB(1) = TNOW - XL*ALOG( RNUM )
        JTRIB(1) = 1
        CALL    FILEM( 1,NSET,QSET )
        RETURN
        END
        SUBROUTINE      RQEST( NSET,QSET )
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id.     RQEST.FOR                               /
C/      Date-written.   11th,Feb,1984                           /
C/      Remarks.        Placement of request for information    /
C/                      from page 273                           /
C/                                                              /
C////////////////////////////////////////////////////////////////
C
        DIMENSION       NSET(1),QSET(1)
        COMMON/C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
     $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
        COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
     $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
     $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
     $  JCLR,JTRIB(12)
        COMMON /U1/ NARC,NSCAN,JBUFF,NSTA(10),JRPLY(10)
        COMMON /U2/ XL,NTER,IBUFF,CDIAL(2),CREAD(2),SRTIM,SCTIM,
     $  TRTIM,DLTIM,COMTIM(2)
C
        J = JTRIB( 2 )
        JTRIB( 1 ) = 20
        CALL    FILEM( 2,NSET,QSET )
        JRPLY( J ) = 2
        RETURN
        END
        SUBROUTINE      SCAN( NSET,QSET )
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id.     SCAN.FOR                                /
C/      Date-written.   11th,Feb,1984                           /
C/      Remarks.        Subroutine SCAN controls the scanner    /
C/                      and is called each time the scanner     /
C/                      can intettogate a scan point.           /
C/                      From page 274                           /
C/                                                              /
C////////////////////////////////////////////////////////////////
C
        DIMENSION       NSET(1),QSET(1)
        COMMON/C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
     $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
        COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
     $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
     $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
     $  JCLR,JTRIB(12)
        COMMON /U1/ NARC,NSCAN,JBUFF,NSTA(10),JRPLY(10)
        COMMON /U2/ XL,NTER,IBUFF,CDIAL(2),CREAD(2),SRTIM,SCTIM,
     $  TRTIM,DLTIM,COMTIM(2)
C
C       --- Test to see if scan point has a request which is to be 
C           transferred to the buffer.
C
        K = JRPLY( NSCAN )
        GO TO (4,1,4,4),K
C
C       --- Test to see if buffer is full. If buffer is full, stop 
C           scanner and set buffer index to full ststus and return
C
1       IF ( NQ(3) - IBUFF ) 3,2,2
2       JBUFF = 1
        RETURN
C
C       --- If buffer is not full, find the request at the scan point
C           and transfer it to the buffer.
C
3       CALL    FINDN( NSCAN,5,2,2,KCOL,NSET,QSET )
        CALL    RMOVE( KCOL,2,NSET,QSET )
        JTRIB(1) = 30
        CALL    FILEM( 3,NSET,QSET )
C
C       --- File request in file 3, the file of calls in buffer.
C           Schedule arrival of answer to the request to occur at
C           current time plus the transfer time from the scanner to 
C           the buffer and from the buffer to the station plus 
C           the computer computation time.
C
        JRPLY( NSCAN ) = 3
        ADDTIM = TRTIM + DLTIM
        ATRIB( 1 ) = TNOW + ADDTIM + UNFRM( COMTIM(1),COMTIM(2) )
        JTRIB( 1 ) = 4
        CALL    FILEM( 1,NSET,QSET )
C
C       --- Set scanner delay time as the sum of the transfer time plus
C           scan time plus movement time.
C
        SUMTIM = SRTIM + SCTIM + TRTIM
        ATRIB( 1 ) = TNOW + SUMTIM
        GO TO 5
C
C       --- Set scan time delay equal to scan time plus movement time
C
4       SUMTIM = SRTIM + SCTIM
        ATRIB( 1 ) = TNOW + SUMTIM
C
C       --- Move scanner to next position and schedule another scan
C
5       IF( NSCAN - NTER ) 7,6,6
6       NSCAN = 0
7       JTRIB( 1 ) = 3
        CALL    FILEM( 1,NSET,QSET )
        NSCAN = NSCAN + 1
        RETURN
        END
        SUBROUTINE      ANSER( NSET,QSET )
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id.     ANSER.FOR                               /
C/      Date-written.   11th,Feb,1984                           /
C/      Remarks.        Subroutine ANSER ia called whenever an  /
C/                      answer to request is ready.             /
C/                      From page 275                           /
C/                                                              /
C////////////////////////////////////////////////////////////////
C
        DIMENSION       NSET(1),QSET(1)
        COMMON/C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
     $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
        COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
     $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
     $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
     $  JCLR,JTRIB(12)
        COMMON /U1/ NARC,NSCAN,JBUFF,NSTA(10),JRPLY(10)
        COMMON /U2/ XL,NTER,IBUFF,CDIAL(2),CREAD(2),SRTIM,SCTIM,
     $  TRTIM,DLTIM,COMTIM(2)
C
C       --- Find request for which an answer has been determined
C           and remove it from the file of calls requested and stored 
C           in the buffer.
C
        J  = JTRIB( 2 )
        CALL    FINDN( J,5,3,2,KCOL,NSET,QSET )
        CALL    RMOVE( KCOL,3,NSET,QSET )
        TI = TNOW - ATRIB( 1 )
        CALL    COLCT( TI,1,NSET,QSET )
        SUMT = SRTIM + SCTIM + TRTIM + DLTIM
        DELT = ( COMTIM(2) - COMTIM(1) + SUMT ) / 20.0
        CALL    HISTO( TI,SUMT,DELT,1 )
        JRPLY( J ) = 4
C
C       --- Schedule an end of service event for the customer to
C           occur at current time plus customer's reading time
C
        ATRIB(1) = TNOW + UNFRM( CREAD(1),CREAD(2) )
        JTRIB(1) = 5
        CALL    FILEM(1,NSET,QSET)
C
C       --- Determine if buffer was full 
C
        IF ( JBUFF ) 2,2,1
C
C       --- If buffer was full, set it to nonfull status and call 
C           subroutine SCAN to start the scanner moving again.
C
1       JBUFF = 0
        CALL    SCAN( NSET,QSET )
2       RETURN
        END
        SUBROUTINE      ENDSV( NSET,QSET )
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id      ENDSV.FOR                               /
C/      Date-written.   11th,Feb,1984                           /
C/      Remarks.        Subroutine ENDSV is called eack time    /
C/                      a customer is finished with the answer  /
C/                      to his request.                         /
C/                      From page 276                           /
C/                                                              /
C////////////////////////////////////////////////////////////////
C
        DIMENSION       NSET(1),QSET(1)
        COMMON/C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
     $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
        COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
     $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
     $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
     $  JCLR,JTRIB(12)
        COMMON /U1/ NARC,NSCAN,JBUFF,NSTA(10),JRPLY(10)
        COMMON /U2/ XL,NTER,IBUFF,CDIAL(2),CREAD(2),SRTIM,SCTIM,
     $  TRTIM,DLTIM,COMTIM(2)
C
C       --- Collect statistics on number of customers at station J
C
        J = JTRIB( 2 )
        X = NSTA( J )
        CALL    TMST( X,TNOW,J,NSET,QSET )
C
C       --- Decrement number of customers at station J by one
C
        NSTA( J ) = NSTA(J ) - 1
        JRPLY( J ) = 1
C
C       --- Set line from station J to free status
C
        IF ( NSTA(J) ) 3,3,2
C
C       --- If a customer is waitting for station J, schedule a 
C           plavement of request event at station J
C
2       ATRIB( 1 ) = TNOW + UNFRM( CDIAL(1),CDIAL(2) )
        JTRIB( 1 ) = 2
        JTRIB( 2 ) = J
        CALL    FILEM( 1,NSET,QSET )
3       RETURN
        END
